SuperHack/SuperHack CD.bin/CODING/DELPHI/CHOOZDCL.ZIP/CHOOZDCL.PAS

Pascal/Delphi Source File | 1996-11-30 | 5.2 KB | 216 lines

{$X+,D-,F+}
program choozdcl;

{$R CHOOZ.RES}

uses
  winTypes, winProcs, strings, oWindows;

const
  appName: pChar = 'Delphi Launcher';

type
  tDelphiLauncher = object(tApplication)
    procedure initMainWindow; virtual;
    destructor done; virtual;
  end;

  pLaunchWindow = ^tLaunchWindow;
  tLaunchWindow = object(tWindow)
    constructor init(aParent: pWindowsObject;
     aName: pChar);
    destructor done; virtual;
    procedure WMCreate(var Msg: TMessage);
     virtual wm_First + wm_create;
    procedure WMActivate(var Msg: TMessage);
     virtual wm_First + wm_Activate;
    procedure WMCommand(var Msg: TMessage);
     virtual wm_First + wm_Command;
    procedure fatal(const msg: string);
  private
    firstActivation: boolean;
  public
    count: word;
    popup: hMenu;
  end;

var
  iniName: array [0..80] of char;

constructor tLaunchWindow.init(aParent: pWindowsObject;
 aName: pChar);
begin
  count := 0;
  firstActivation := true;
  tWindow.init(aParent, aName);
 {create an invisible, popup window}
  attr.style := ws_popup;
end;

destructor tLaunchWindow.done;
begin
  tWindow.done;
end;

destructor tDelphiLauncher.done;
begin
  mainWindow^.done;
end;

procedure tLaunchWindow.fatal(const msg: string);
var
  errMsg: array [0..255] of char;
begin
  messageBox(hWindow, strPCopy(errMsg, msg), appName, mb_iconExclamation + mb_ok);
  postQuitMessage(1);
end;

procedure tLaunchWindow.WMCreate(var Msg: TMessage);
begin
  if paramStr(1) = ''
  then
    strCopy(iniName, 'CHOOZDCL.INI')
  else
    strPCopy(iniName, paramStr(1));
end;

procedure doEvents;
var
  m: tMsg;
begin
  while peekMessage(m, 0, 0, 0, pm_remove)
  do
    if m.message = wm_quit
    then begin
      postQuitMessage(m.wParam);
      exit;
     end
    else begin
      translateMessage(m);
      dispatchMessage(m);
    end;
end;

procedure tLaunchWindow.WMCommand(var Msg: TMessage);
var
  libSect: array [0..1024] of char;
  frmSect, toSect, key: array [0..80] of char;
  toIni, command: array [0..128] of char;
  valu: array [0..255] of char;
  nrStr: string[2];
  frm, idx: word;
begin
  if (msg.wParam > 0) and (count >= msg.wParam)
  then begin
    toIni[0] := #0;
    getPrivateProfileString(strCopy(frmSect, 'General'),
     'IniFile', '', toIni, sizeOf(toIni), iniName);
    if toIni[0] = #0
    then
      strCopy(toIni, 'DELPHI.INI');
    toSect[0] := #0;
    getPrivateProfileString(frmSect, 'IniSection',
     '', toSect, sizeOf(toSect), iniName);
    if toSect[0] = #0
    then
      strCopy(toSect, 'Library');
    str(msg.wParam, nrStr);
    fillChar(libSect, sizeOf(libSect), 1);
    libSect[0] := #0;
    getPrivateProfileString(strPCopy(frmSect, 'Config' + nrStr),
     nil, '', libSect, sizeOf(libSect), iniName);
    if libSect[0] = #0
    then
      fatal('Section [' + strPas(frmSect) + '] not found in '
       + strPas(iniName))
    else begin
      frm := 0; idx := 0;
      while (idx < high(libSect))
       and ((libSect[idx] > #0)
       or ((libSect[idx] = #0) and (libSect[succ(idx)] <> #0)))
      do begin
        inc(idx);
        if libSect[idx] = #0
        then begin
          move(libSect[frm], key[0], idx - frm);
          valu[0] := #0;
          getPrivateProfileString(frmSect, key,
           '', valu, sizeOf(valu), iniName);
          writePrivateProfileString(toSect, key,
           valu, toIni);
          frm := succ(idx);
        end;
      end;
    end;
    destroyMenu(popup);
    doEvents;
    command[0] := #0;
    getPrivateProfileString('General', 'CommandLine',
     '', command, sizeOf(command), iniName);
    if command[0] = #0
    then
      strCopy(command, 'DELPHI.EXE');
    if winExec(command, sw_show) < 32
    then
      fatal('Error launching ' + strPas(command));
  end;
end;

procedure tLaunchWindow.WMActivate(var Msg: TMessage);
const
  tpm_centerAlign = $04;
var
  cfgName: array [0..255] of char;
  cfgNr: array [0..8] of char;
  nrStr: string[2];
  curPos: tPoint;
begin
  if firstActivation
  then begin
    firstActivation := false;
    repeat
      str(succ(count), nrStr);
      strPCopy(cfgNr, 'Config' + nrStr);
      cfgName[0] := #0;
      getPrivateProfileString('Configurations', cfgNr, #0,
       cfgName, sizeOf(cfgName), iniName);
      if cfgName[0] <> #0
      then begin
        inc(count);
        if count = 1
        then
          popup := createPopupMenu;
        if (popup = 0)
         or not appendMenu(popup, mf_string, count, cfgName)
        then
          fatal('Error creating menu');
      end;
    until (count = 20) or (cfgName[0] = #0);
    if count = 0
    then
      fatal('Config1 entry missing from [Configurations] section of '
       + strPas(iniName));
    getCursorPos(curPos);
    if not trackPopupMenu(popup, tpm_centerAlign, curPos.x - 5,
     curPos.y - 5, 0, hWindow, nil)
    then begin
      destroyMenu(popup);
      fatal('Unable to display menu');
    end;
    postQuitMessage(0);
  end;
end;

procedure tDelphiLauncher.initMainWindow;
begin
  mainWindow := new(pLaunchWindow, init(nil, appName));
end;

var
  application: tDelphiLauncher;

begin
  application.init(appName);
  application.run;
  application.done;
end.